home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / utilunits / PasToC.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  2.7 KB  |  119 lines
  1. {
  2.     This file is part of the Free Pascal run time library.
  3.  
  4.     A file in Amiga system run time library.
  5.     Copyright (c) 2000 by Nils Sjoholm
  6.     member of the Amiga RTL development team.
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16. unit PasToC;
  17.  
  18. interface
  19.  
  20. function Pas2C( s : String): PChar;
  21.  
  22. implementation
  23.  
  24. const
  25.    MEMF_ANY      = %000000000000000000000000;   { * Any type of memory will do * }
  26.    MEMF_PUBLIC   = %000000000000000000000001;
  27.   
  28.    MEMF_CLEAR    = %000000010000000000000000;
  29.  
  30. Type
  31.     
  32.     ULONG = Longint;
  33.  
  34.     pRemember = ^tRemember;
  35.     tRemember = record
  36.         NextRemember    : pRemember;
  37.         RememberSize    : ULONG;
  38.         Memory          : Pointer;
  39.     end;
  40.  
  41. var
  42.     myrememberkey : pRemember;
  43.     remember_exit : pointer;
  44.  
  45. FUNCTION fpcAllocRemember(VAR rememberKey : pRemember; size : ULONG; flags : ULONG) : POINTER;
  46. BEGIN
  47.   ASM
  48.     MOVE.L  A6,-(A7)
  49.     MOVEA.L rememberKey,A0
  50.     MOVE.L  size,D0
  51.     MOVE.L  flags,D1
  52.     MOVEA.L _IntuitionBase,A6
  53.     JSR -396(A6)
  54.     MOVEA.L (A7)+,A6
  55.     MOVE.L  D0,@RESULT
  56.   END;
  57. END;
  58.  
  59. PROCEDURE fpcFreeRemember(VAR rememberKey : pRemember; reallyForget : LONGINT);
  60. BEGIN
  61.   ASM
  62.     MOVE.L  A6,-(A7)
  63.     MOVEA.L rememberKey,A0
  64.     MOVE.L  reallyForget,D0
  65.     MOVEA.L _IntuitionBase,A6
  66.     JSR -408(A6)
  67.     MOVEA.L (A7)+,A6
  68.   END;
  69. END;
  70.  
  71. Function StringPcharCopy(Dest: PChar; Source: String):PChar;
  72. var
  73.    counter : byte;
  74. Begin
  75.    counter := 0;
  76.   { if empty pascal string  }
  77.   { then setup and exit now }
  78.   if Source = '' then
  79.   Begin
  80.     Dest[0] := #0;
  81.     StringPCharCopy := Dest;
  82.     exit;
  83.   end;
  84.   for counter:=1 to length(Source) do
  85.   begin
  86.     Dest[counter-1] := Source[counter];
  87.   end;
  88.   { terminate the string }
  89.   Dest[counter] := #0;
  90.   StringPcharCopy:=Dest;
  91. end;
  92.  
  93. function Pas2C(s : string): PChar;
  94. var
  95.     themem : Pointer;
  96. begin
  97.     themem := fpcAllocRemember(myrememberkey,length(s)+1, MEMF_CLEAR or MEMF_PUBLIC);
  98.     if themem = nil then begin
  99.         writeln('Can''t allocate memory for string');
  100.         halt(20);
  101.     end else begin
  102.         StringPCharCopy(themem,s);
  103.         Pas2C := themem;
  104.     end;
  105. end;
  106.  
  107. procedure ReleasePasToC;
  108. begin
  109.     ExitProc := remember_exit;
  110.     fpcFreeRemember(myrememberkey,1);
  111. end;
  112.  
  113. begin
  114.     myrememberkey := nil;
  115.     remember_exit := ExitProc;
  116.     ExitProc := @ReleasePasToC;
  117. end.
  118.  
  119.